Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/mxutil/tspak17/snd2sam.pas

Pascal/Delphi Source File | 1994-09-11 | 44.9 KB | 1,298 lines

(* Snd2sam.pas - Convert DeskMate .snd to Amiga music module sample.
   Version 1.1
   Jeffrey L. Hayes
   September 11, 1994

   This version has been modified to add support for new-format .snd files.

   This program converts a DeskMate Sound.pdm instrument or sound file to
   one or more .sam files for use with Amiga .mod editors, particularly
   ModEdit v.3.1.  The input .snd file must be uncompressed.  For each note
   in the instrument file, two output files are created:  (1) a .sam file,
   and (2) a .not (ASCII) file giving needed information about the .sam
   file, including its pitch, large-scale tuning, transposition, and looping
   parameters.  Since the .sam file is a headerless format, the user is
   required to enter the information from the .not file manually when using
   the sample in a .mod editor.

   The syntax is:

       SND2SAM <.snd file> [<directory>]

   The input .snd filename is required and may include drive and path.  If
   no extension is specified, it defaults to .snd; a file without an
   extension can by used by ending the name with a period.

   The second parameter, which is optional, is the directory where the
   output .sam and .not files will be placed.  If not specified, it
   defaults to the current directory.

   The output filenames are generated from the input .snd filename.  For
   the first note, the filename of the .snd file (without drive, path, or
   extension) is taken, and extensions of .sam and .not are attached.  For
   the second and subsequent notes, a digit 2-9 or letter A-G is appended
   to the filename, overwriting the last character of the filename if
   necessary.  For example, if the following is entered (where piano.snd is
   an instrument file with 3 notes defined):

       snd2sam a:piano

   The following files will be created in the current directory:

       piano.sam
       piano.not
       piano2.sam
       piano2.not
       piano3.sam
       piano3.not

   For a note in an instrument file with pitch set, the .not file will
   take the following format.  In this example, clarinet.snd has at
   least one note defined, and note 1 is C3 in Sound.pdm (middle C, or
   C2 in .mod pitch).

       Data for sample file clarinet.sam
       Actual pitch at C2:  G1 finetune +1

       Tuning for ModEdit v.3.1:
       Set tuning to:  G2
       Transpose up 1 octave(s).

       Tuning for other editors:
       Transpose up 5 semitone(s).

       Sample is looped.
       Repeat start:  3828 (1914 words)
       Repeat length:  1356 (678 words)

   The .not file begins with the name of the sample file it describes.  The
   next line gives the actual pitch of the note (in .mod pitch) if played
   back at period 428.  The pitch given here need not be a valid .mod
   pitch; it can have a huge octave number, or even a negative one.

   The next few lines describe how to set the large-scale tuning in ModEdit
   so that the pitch will be true (a C will be a C, a D-flat a D-flat, etc.)
   and so that the range will be as large as possible (a large-scale tuning
   in octave 2 is always selected).  Depending on the .snd file, it may be
   necessary to transpose the sample's notes one or more octaves in either
   direction.  In this example, the notes will sound one octave lower than
   they are written when the tuning is set as indicated, so if working from
   a musical score one must transpose them up one octave.

   Other .mod editors do not offer large-scale tuning; a note played at
   period 428 is always displayed as C2.  In this case, the sample's notes
   will sound 5 semitones lower than they are written, so if working from
   a musical score one must transpose them up 5 semitones.

   The last part is the sample's looping information.  In the example, the
   first note of clarinet.snd has the sustain region set, and this region
   will be used as the repeat region for the sample.  The repeat start and
   length are given in bytes (since ModEdit requires bytes) and in words
   (which is what the .mod format requires).

   For new-format .snd files, the looping information is not given since I
   don't know where in the .snd header it is kept.

   For a sound file, or for a note in an instrument file with no pitch or
   sustain set, the .not file will take the following format:

       Data for sample file meep.sam
       No pitch set

       Sample is not looped.

   The .sam file will consist of a zero word followed by 8-bit signed PCM
   samples.  If converted from a note with sustain set, the part of the
   note after the sustain will be discarded (.snd notes have attack,
   sustain, and decay, while .mod samples only have a beginning and a
   looped section - no decay after the looping).
*)

program snd2sam;

uses dos;

(*********************************************************************)
(*************************** constants *******************************)
(*********************************************************************)

const
  maxsample =                (* maximum number of samples in a .sam file *)
    131070;
  bufsize =                  (* size of buffer for sound samples *)
    32768;

(*********************************************************************)
(***************************** types *********************************)
(*********************************************************************)

type
  noterec = record         (* needed fields from the .snd note record *)
      valid:               (* true if note is set - needed in case some *)
        boolean;           (*   notes must be skipped                   *)
      pitch:               (* pitch of note at recording freqency; 1 = *)
        byte;              (*   A-1 in .mod pitch; -1 if not set       *)
      start_offset,        (* offset in .snd file of start of note data *)
      length,              (* number of note samples *)
      sustain_start,       (* start of sustain region - 0 if none *)
      sustain_end:         (* end of sustain region - 0 if none *)
        longint;
        (* Array of pointers to note data on the heap - each pointer *)
        (*   addresses at most bufsize bytes of sound data.  Notes   *)
        (*   longer than 128k will be skipped.                       *)
      data:
        array [1..4] of pointer;
    end; (* record *)

  notearray = array [1..16] of noterec;

(*********************************************************************)
(************************ global variables ***************************)
(*********************************************************************)

var
  sndname,                   (* filename of input .snd file *)
  basename,                  (* base name of .sam and .not files *)
  currentdir,                (* current directory *)
  outdir:                    (* directory for .sam and .not files *)
    string;
  numnotes,                  (* number of notes in the .snd file *)
  note:                      (* note in the .snd file being converted *)
    byte;
  notelist:                  (* list of notes in the .snd file *)
    notearray;
  nextexit:                  (* next exit procedure in chain *)
    pointer;

(*********************************************************************)
(*************************** subroutines *****************************)
(*********************************************************************)

procedure display_intro;
  (*  This procedure displays an introductory message to the user.  *)

begin (* display_intro *)
  writeln;
  writeln( 'Snd2sam - DeskMate .snd to Amiga .mod sample conversion ',
    'program' );
  writeln;
end; (* display_intro *)

(*********************************************************************)

function lastpos(
  c:                         (* character to be searched for *)
    char;
  st:                        (* string to be searched *)
    string ):
      integer;
  (*  This function returns the position of the last occurrence of c in
      st, or 0 if it isn't there.  Same as the built-in pos() function,
      but it starts at the other end of the string.  *)

var
  place,                     (* position of character found *)
  i:                         (* for looping over the characters *)
    integer;

begin (* lastpos *)
  place := 0;
  for i := 1 to length( st ) do
    if st[i] = c then
      place := i;
  lastpos := place;
end; (* lastpos *)

(*********************************************************************)

procedure stop(
  st1,                       (* first line to display *)
  st2:                       (* second line to display *)
    string );
  (*  This procedure displays a 1- or 2-line message and halts the
      program.  *)

begin (* stop *)
  writeln( st1 );
  if st2 <> '' then
    writeln( st2 );
  halt;
end; (* stop *)

(*********************************************************************)

procedure process_command_line(
  var sndname,               (* name of input .snd file *)
      outdir:                (* directory for .sam and .not files *)
        string );
  (*  This procedure reads the command-line parameters and returns the
      values above.  *)

var
  dotpos:                    (* position of '.' in sndname *)
    integer;

begin (* process_command_line *)
    (* if no parameters (or more than 2), display syntax *)
  if (paramcount = 0) or (paramcount > 2) then
    stop( 'Syntax:',
          '  SND2SAM <.snd file> [<output directory>]' );

    (* the first parameter is the input filename *)
  sndname := paramstr( 1 );

    (* set input file extension to .snd if not specified *)
  dotpos := lastpos( '.', sndname );
  if dotpos = 0 then
    sndname := sndname + '.snd';

    (* set the output directory *)
  if paramcount = 1 then
    outdir := '.'
  else
    outdir := paramstr( 2 );
end; (* process_command_line *)

(*********************************************************************)

procedure readdata(
  var sndfile:               (* file to read from *)
    file;
  var buffer;                (* buffer to read into *)
  var nbytes:                (* on entry, number of bytes to read     *)
    word );                  (* ... on exit, number successfully read *)
  (*  This procedure encapsulates blockread(), halting the program on
      file errors.  *)

var
  result:                    (* number of bytes successfully read *)
    word;

begin (* readdata *)
  {$I-} blockread( sndfile, buffer, nbytes, result ); {$I+}
  if IOResult <> 0 then
    stop( 'Error reading input file - halting.', '' );
  nbytes := result;
end; (* readdata *)

(*********************************************************************)

procedure read_notedata(
  sndname:                   (* name of input file, for messages *)
    string;
  var sndfile:               (* input .snd file *)
    file;
  var note:                  (* note, returned with sound read in *)
    noterec );
  (*  This procedure uses the data in the note record to read the sound
      samples for the note from disk into a set of dynamically-allocated
      buffers, returning pointers to the buffers.  Halts the program if
      out of memory.  *)

var
  bytesleft:                 (* number of bytes of sound data remaining *)
    longint;
  thistime:                  (* number of bytes read this pass *)
    word;
  i:                         (* for looping over the buffer pointers *)
    integer;

begin (* read_notedata *)
  with note do
    begin

      (* if flagged invalid, just exit *)
    if not valid then
      exit;

      (* seek to start of note samples *)
    {$I-} seek( sndfile, start_offset ); {$I+}
    if IOResult <> 0 then
      stop( 'Seek failed on file "' + sndname + '".', '' );

      (* read in the sample data *)
    bytesleft := length;
    i := 1;
      (* while more sound data do: *)
    while bytesleft > 0 do
      begin
        (* do bufsize bytes, or what's left, whichever is less *)
      if bytesleft > bufsize then
        thistime := bufsize
      else
        thistime := bytesleft;
        (* adjust count of bytes remaining *)
      bytesleft := bytesleft - thistime;
        (* halt program if out of memory *)
      if maxavail < thistime then
        stop( 'Insufficient memory.', '' );
        (* allocate a sound buffer *)
      getmem( data[i], thistime );
        (* read in sound data *)
      readdata( sndfile, data[i]^, thistime );
        (* go to next buffer *)
      i := i + 1;
      end; (* while more sound data *)

    end; (* with *)
end; (* read_notedata *)

(*********************************************************************)

function is_newsnd(
  sndname:                   (* name in input file *)
    string ):
      boolean;
  (*  This function returns true if the input file is a new-format .snd
      file, or at least _not_ an old-format .snd file.  *)

var
  sndfile:                   (* input file *)
    file;
  firstbyte:                 (* first byte of the file *)
    byte;
  IDtag:                     (* ID tag for new .snd file *)
    array [0..1] of byte;
  nbytes:                    (* number of bytes to read (1 or 2) *)
    word;

begin (* is_newsnd *)
    (* open the input file *)
  assign( sndfile, sndname );
  {$I-} reset( sndfile, 1 ); {$I+}
    (* Note:  For some bizarre reason, reset() fails on read-only files. *)
    (*   I decided to live with it (... and make my users live with it). *)
  if IOResult <> 0 then
    stop( 'Unable to open file:',
          '  ' + sndname );

    (* if the file does not contain at least 46 bytes, it's not a new-
       format file (we verify the file size to keep from seeking or reading
       past the end of the file) *)
  if filesize( sndfile ) < 46 then
    begin
    is_newsnd := false;
    exit;
    end;

    (* read the first byte of the file *)
  nbytes := 1;
  readdata( sndfile, firstbyte, nbytes );

    (* seek to the magic number *)
  {$I-} seek( sndfile, 44 ); {$I+}
  if IOResult <> 0 then
    stop( 'Seek failed on file "' + sndname + '".', '' );

    (* read the ID tag *)
  nbytes := 2;
  readdata( sndfile, IDtag, nbytes );

    (* close the input file *)
  close( sndfile );

    (* return true if ID is a match *)
  is_newsnd := (firstbyte <> $1A) and (IDtag[0] = $1A) and (IDtag[1] = $80);
end; (* is_newsnd *)

(*********************************************************************)

procedure read_newsnd(
  sndname:                   (* name of input .snd file *)
    string;
  var numnotes:              (* number of notes in the file, returned *)
    byte;
  var notelist:              (* array of note information, returned *)
    notearray );
  (*  This procedure reads an entire new-format .snd file into memory and
      sets up the list of note information for the converter procedure.  *)

var
  sndfile:                   (* input file *)
    file;
  nbytes:                    (* number of bytes read *)
    word;
  scratchst:                 (* scratch string *)
    string;
  i:                         (* for looping over the notes *)
    integer;
  nextnote:                  (* offset in file of next note record *)
    longint;

    (* 114-byte fixed .snd header *)
  fixedheader:
    record
      soundname:             (* ASCIIZ name of sound *)
        packed array [1..10] of char;
      unknown1:              (* (function unknown) *)
        array [1..34] of byte;
      IDtag:                 (* new .snd ID tag:  1Ah 80h *)
        array [1..2] of byte;
      numnotes,              (* number of notes in the file *)
      instnum:               (* instrument number *)
        word;
      unknown2:              (* (function unknown) *)
        array [1..16] of byte;
      compression:           (* compression code *)
        word;
      unknown3:              (* (function unknown) *)
        array [1..20] of byte;
      rate:                  (* sampling rate in Hz *)
        word;
      unknown4:              (* (function unknown) *)
        array [1..24] of byte;
    end; (* record *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure read_noteheader(
    sndname:                 (* name of input file, for messages *)
      string;
    var sndfile:             (* input .snd file *)
      file;
    var note:                (* note information returned *)
      noterec;
    var nextnote:            (* offset in file of next note record, returned *)
      longint );
    (*  This procedure reads in a note record from the .snd header,
        verifies the note data, and returns the note information.  *)

  var
    nbytes:                  (* number of bytes read *)
      word;

      (* 46-byte note record *)
    noteheader:
      record
        nextnote:            (* offset in file of next sample descriptor *)
          longint;
        unknown1:            (* (function unknown) *)
          array [1..2] of byte;
        pitch,               (* pitch of note (see Newsnd.for) *)
        unknown2,            (* (function unknown) *)
        rangelo,             (* low limit of pitch range *)
        rangehi:             (* high limit of pitch range *)
          byte;
        start,               (* start of note samples in file *)
        length,              (* length of sample data, after compression *)
                             (*   if any                                 *)
        nsamples:            (* number of samples in note *)
          longint;
        unknown3:            (* (function unknown) *)
          array [1..24] of byte;
      end; (* record *)

  begin (* read_noteheader *)
      (* read note record *)
    nbytes := 46;
    readdata( sndfile, noteheader, nbytes );
    if nbytes <> 46 then
      stop( 'Unexpected end-of-file reading .snd header of file:',
            '  ' + sndname );

      (* verify note record *)
    with noteheader do
      begin
        (* start out pessimistic *)
      note.valid := false;
        (* if not a valid pitch (or lack of one), skip *)
      if not (pitch in [1..$3F,$FF]) then
        begin
        writeln( 'Note pitch invalid - note skipped.' );
        exit;
        end;
        (* if file offset and length invalid, skip *)
      if (start < 0) or (nsamples < 0) or (start+nsamples < 0) or
        (start+nsamples > filesize( sndfile )) then
        begin
        writeln( '.snd file corrupt or truncated - note skipped.' );
        exit;
        end;
        (* if too long, skip *)
      if nsamples > maxsample then
        begin
        writeln( 'Note too long for .mod sample - note skipped.' );
        exit;
        end;
        (* if no samples, skip *)
      if nsamples = 0 then
        begin
        writeln( 'Note contains no sound data - note skipped.' );
        exit;
        end;
      end; (* with *)

      (* copy data into record returned *)
    note.valid := true;
    note.pitch := noteheader.pitch;
    note.start_offset := noteheader.start;
    note.length := noteheader.nsamples;

      (* we don't know where the sustain interval is stored in the new file
         format, so indicate that sustain is not set *)
    note.sustain_start := 0;
    note.sustain_end := 0;

      (* return pointer to next note record *)
    nextnote := noteheader.nextnote;
  end; (* read_noteheader *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

begin (* read_newsnd *)
    (* open the input file *)
  assign( sndfile, sndname );
  {$I-} reset( sndfile, 1 ); {$I+}
  if IOResult <> 0 then
    stop( 'Unable to open file:',
          '  ' + sndname );

    (* read fixed header *)
  nbytes := 114;
  readdata( sndfile, fixedheader, nbytes );
  if nbytes <> 114 then
    stop( 'Unexpected end-of-file reading .snd header of file:',
          '  ' + sndname );

    (* verify header data *)
  with fixedheader do
    begin
      (* if no .snd signature, halt *)
    if (IDtag[1] <> $1A) or (IDtag[2] <> $80) then
      stop( 'File "' + sndname + '" is not an .snd file.', '' );
      (* halt if invalid number of notes *)
    if (numnotes = 0) or (numnotes > 16) then
      stop( 'Invalid number of notes in file:',
            '  ' + sndname );
      (* if compressed, halt *)
    if compression <> 0 then
      stop( 'File "' + sndname + '" is compressed.',
            'Use Sound.pdm to uncompress before converting.' );
    end; (* with *)

    (* save number of notes *)
  numnotes := fixedheader.numnotes;

    (* read the note headers *)
  writeln( 'Reading note information ...' );
  for i := 1 to numnotes do
    begin
    read_noteheader( sndname, sndfile, notelist[i], nextnote );
    {$I-} seek( sndfile, nextnote ); {$I+}
    if IOResult <> 0 then
      stop( 'Seek failed on file "' + sndname + '".', '' );
    end; (* for each note record *)

    (* read the note samples *)
  writeln( 'Reading sample data ...' );
  for i := 1 to numnotes do
    read_notedata( sndname, sndfile, notelist[i] );

    (* close the input file *)
  close( sndfile );
end; (* read_newsnd *)

(*********************************************************************)

procedure read_oldsnd(
  sndname:                   (* name of input .snd file *)
    string;
  var numnotes:              (* number of notes in the file, returned *)
    byte;
  var notelist:              (* array of note information, returned *)
    notearray );
  (*  This procedure reads the entire old-format .snd file into memory (an
      .snd file must fit in RAM or Sound.pdm won't use it) and sets up the
      list of note information for the converter procedure.  *)

var
  sndfile:                   (* input .snd file *)
    file;
  nbytes:                    (* number of bytes read *)
    word;
  scratchst:                 (* scratch string *)
    string;
  i:                         (* for looping over the notes *)
    integer;

    (* 16-byte fixed .snd header *)
  fixedheader:
    record
      signature,             (* .snd signature byte 1Ah *)
      compression,           (* compression code *)
      numnotes,              (* number of notes in the file *)
      instnum:               (* instrument number *)
        byte;
      instname:              (* name of instrument *)
        packed array[1..10] of char;
      rate:                  (* sampling rate in Hz *)
        word;
    end; (* record *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure read_noteheader(
    sndname:                 (* name of input file, for messages *)
      string;
    var sndfile:             (* input .snd file *)
      file;
    var note:                (* note information returned *)
      noterec );
    (*  This procedure reads in a note record from the .snd header,
        verifies the note data, and returns the note information.  *)

  var
    nbytes:                  (* number of bytes read *)
      word;

      (* 28-byte note record *)
    noteheader:
      record
        pitch,               (* pitch of note (see Snd.for) *)
        pitchflag,           (* 0 = no pitch set, -1 = pitch set *)
        rangelo,             (* low limit of pitch range *)
        rangehi:             (* high limit of pitch range *)
          byte;
        start,               (* start of note samples in file *)
        compressed_length,   (* length of compressed data, 0 if *)
                             (*   uncompressed                  *)
        unknown,             (* (function unknown) *)
        nsamples,            (* number of samples in note *)
        sustain_start,       (* start of sustain region *)
        sustain_end:         (* end of sustain region *)
          longint;
      end; (* record *)

  begin (* read_noteheader *)
      (* read note record *)
    nbytes := 28;
    readdata( sndfile, noteheader, nbytes );
    if nbytes <> 28 then
      stop( 'Unexpected end-of-file reading .snd header of file:',
            '  ' + sndname );

      (* verify note record *)
    with noteheader do
      begin
        (* start out pessimistic *)
      note.valid := false;
        (* if not a valid pitch (or lack of one), skip *)
      if not (pitch in [1..$3F,$FF]) then
        begin
        writeln( 'Note pitch invalid - note skipped.' );
        exit;
        end;
        (* if file offset and length invalid, skip *)
      if (start < 0) or (nsamples < 0) or (start+nsamples < 0) or
        (start+nsamples > filesize( sndfile )) then
        begin
        writeln( '.snd file corrupt or truncated - note skipped.' );
        exit;
        end;
        (* if too long, skip *)
      if nsamples > maxsample then
        begin
        writeln( 'Note too long for .mod sample - note skipped.' );
        exit;
        end;
        (* if no samples, skip *)
      if nsamples = 0 then
        begin
        writeln( 'Note contains no sound data - note skipped.' );
        exit;
        end;
        (* if sustain region invalid, skip *)
      if (sustain_start < 0) or (sustain_end < 0) or
        (sustain_start > sustain_end) or (sustain_end > nsamples-1) then
        begin
        writeln( 'Invalid sustain region - note skipped.' );
        exit;
        end;
      end; (* with *)

      (* copy data into record returned *)
    note.valid := true;
    note.pitch := noteheader.pitch;
    note.start_offset := noteheader.start;
    note.length := noteheader.nsamples;
    note.sustain_start := noteheader.sustain_start;
    note.sustain_end := noteheader.sustain_end;
  end; (* read_noteheader *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

begin (* read_oldsnd *)
    (* open the input file *)
  assign( sndfile, sndname );
  {$I-} reset( sndfile, 1 ); {$I+}
  if IOResult <> 0 then
    stop( 'Unable to open file:',
          '  ' + sndname );

    (* read fixed header *)
  nbytes := 16;
  readdata( sndfile, fixedheader, nbytes );
  if nbytes <> 16 then
    stop( 'Unexpected end-of-file reading .snd header of file:',
          '  ' + sndname );

    (* verify header data *)
  with fixedheader do
    begin
      (* if no .snd signature, halt *)
    if signature <> $1A then
      stop( 'File "' + sndname + '" is not an .snd file.', '' );
      (* halt if invalid number of notes *)
    if (numnotes = 0) or (numnotes > 16) then
      stop( 'Invalid number of notes in file:',
            '  ' + sndname );
      (* if compressed, halt *)
    if compression <> 0 then
      stop( 'File "' + sndname + '" is compressed.',
            'Use Sound.pdm to uncompress before converting.' );
      (* if the sampling rate is invalid for an .snd file, halt *)
    if (rate <> 5500) and (rate <> 11000) and (rate <> 22000) then
      begin
      str( rate, scratchst );
      stop( 'Invalid sampling rate of ' + scratchst + ' in file:',
            '  ' + sndname );
      end; (* if bad sampling rate *)
    end; (* with *)

    (* save number of notes *)
  numnotes := fixedheader.numnotes;

    (* read the note headers *)
  writeln( 'Reading note information ...' );
  for i := 1 to numnotes do
    read_noteheader( sndname, sndfile, notelist[i] );

    (* read the note samples *)
  writeln( 'Reading sample data ...' );
  for i := 1 to numnotes do
    read_notedata( sndname, sndfile, notelist[i] );

    (* close the input file *)
  close( sndfile );
end; (* read_oldsnd *)

(*********************************************************************)

procedure get_basename(
  sndname:                   (* name of input .snd file *)
    string;
  var basename:              (* base name of sample and note files *)
    string );
  (*  This procedure extracts the filename of the input .snd file, sans
      drive, path, and extension, and returns it in basename.  *)

var
  colonplace,                (* position of ':' in sndname *)
  slashplace,                (* position of '\' in sndname *)
  dotplace:                  (* position of '.' in sndname *)
    integer;

begin (* get_basename *)
    (* find where the drive and path end *)
  colonplace := lastpos( ':', sndname );
  slashplace := lastpos( '\', sndname );
  if colonplace > slashplace then
    slashplace := colonplace;

    (* delete the drive and path *)
  delete( sndname, 1, slashplace );

    (* find extension *)
  dotplace := lastpos( '.', sndname );

    (* return name without extension *)
  if dotplace = 0 then
    basename := sndname
  else
    basename := copy( sndname, 1, dotplace-1 );
end; (* get_basename *)

(*********************************************************************)

function setname(
  basename:                  (* base name to adjust *)
    string;
  note:                      (* note number *)
    byte ):
      string;
  (*  This function returns the base name of the output .sam and .not
      files, adjusted for the note number.  If the note number is not
      1, a digit or letter is appended to the name to distinguish the
      file, overwriting the last character of the name if necessary.  *)

var
  notechar:                  (* character to be appended *)
    char;

begin (* setname *)
  if note <> 1 then
    begin
    if note < 10 then
      notechar := chr( ord( '0' ) + note )
    else
      notechar := chr( ord( 'A' ) + note - 10 );
    if length( basename ) = 8 then
      basename[8] := notechar
    else
      basename := basename + notechar;
    end; (* if name needs adjusting *)
  setname := basename;
end; (* setname *)

(*********************************************************************)

procedure do_note(
  outdir,                    (* output directory, for messages *)
  basename:                  (* base name of .sam and .not files *)
    string;
  note:                      (* note information record *)
    noterec );
  (*  This procedure converts a note from the .snd file into a .sam and
      a .not file.  *)

var
  samname,                   (* name of sample file *)
  notname:                   (* name of note file *)
    string;
  samfile:                   (* .mod sample file *)
    file;
  notfile:                   (* note file *)
    text;
  loop_start,                (* start of looping region in sample *)
  loop_length:               (* end of looping region in sample *)
    longint;
  is_looped:                 (* true if sample is looped *)
    boolean;

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure compute_loop(
    var note:                (* note record whose looping information is to *)
      noterec;               (*   be computed                               *)
    var is_looped:           (* true if sample is looped *)
      boolean;
    var loop_start,          (* word offset in sample of start of loop *)
        loop_length:         (* length in words of loop *)
      longint );
    (*  This procedure computes the loop start and length for an instrument
        note with sustain set, adjusting the length of the note data to
        discard the decay region.  is_looped returns false if the sample is
        not looped.  *)

  var
    wordlength,              (* length of sample data in words *)
    loop_end:                (* word offset of end of loop *)
      longint;

  begin (* compute_loop *)
    with note do
      begin
        (* compute length in words, round length down *)
      wordlength := length div 2;
      length := wordlength * 2;

        (* compute loop_start, loop_end *)
      loop_start := (sustain_start + 1) div 2;
      loop_end := sustain_end div 2;
      if loop_end > wordlength-1 then
        loop_end := wordlength - 1;

        (* compute loop_length *)
      loop_length := loop_end - loop_start + 1;

        (* if loop_length < 2, no loop *)
      is_looped := loop_length >= 2;
      if not is_looped then
        exit;

        (* adjust loop_start and loop_end to account for zero word *)
        (*   prepended to sample                                   *)
      loop_start := loop_start + 1;
      loop_end := loop_end + 1;

        (* adjust sample length to discard section after the loop *)
      length := loop_end * 2;
      end; (* with *)
  end; (* compute_loop *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure writedata(
    var outfile:             (* file to written to *)
      file;
    var buffer;              (* buffer to write from *)
    nbytes:                  (* number of bytes to write *)
      word );
    (*  This procedure encapsulates blockwrite(), halting the program on
        file errors (including a full disk).  *)

  var
    result:                  (* number of bytes successfully written *)
      word;

  begin (* writedata *)
    {$I-} blockwrite( outfile, buffer, nbytes, result ); {$I+}
    if IOResult <> 0 then
      stop( 'Error writing output file - halting.', '' );
    if result <> nbytes then
      stop( 'Disk full - halting.', '' );
  end; (* writedata *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure signum_convert(
    buffer:                  (* pointer to data buffer *)
      pointer;
    nbytes:                  (* number of bytes in the buffer *)
      word );
    (*  This procedure converts a buffer full of unsigned 8-bit sound
        data to signed.  *)

  begin (* signum_convert *)
    inline( $1E/                       (*   PUSH    DS             *)
            $9C/                       (*   PUSHF                  *)
            $FC/                       (*   CLD                    *)
            $C4/$BE/buffer/            (*   LES     DI,[BP+buffer] *)
            $8C/$C0/                   (*   MOV     AX,ES          *)
            $89/$FB/                   (*   MOV     BX,DI          *)
            $81/$E7/$0F/$00/           (*   AND     DI,0Fh         *)
            $B1/$04/                   (*   MOV     CL,4           *)
            $D3/$EB/                   (*   SHR     BX,CL          *)
            $01/$D8/                   (*   ADD     AX,BX          *)
            $8E/$C0/                   (*   MOV     ES,AX          *)
            $8E/$D8/                   (*   MOV     DS,AX          *)
            $89/$FE/                   (*   MOV     SI,DI          *)
            $8B/$8E/nbytes/            (*   MOV     CX,[BP+nbytes] *)
                                       (* LOOPTOP:                 *)
            $AC/                       (*   LODSB                  *)
            $2C/$80/                   (*   SUB     AL,128         *)
            $AA/                       (*   STOSB                  *)
            $E2/$FA/                   (*   LOOP    LOOPTOP        *)
            $9D/                       (*   POPF                   *)
            $1F );                     (*   POP     DS             *)
  end; (* signum_convert *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure writesam(
    var samfile:             (* output sample file *)
      file;
    note:                    (* note to write *)
      noterec );
    (*  This procedure converts the sound data from an .snd note to
        signed and writes it out.  *)

  var
    zeroword:                (* word of zero bits *)
      word;
    bytesleft:               (* bytes remaining to process *)
      longint;
    thistime:                (* bytes in this buffer *)
      word;
    i:                       (* for looping through data buffers *)
      integer;

  begin (* writesam *)
      (* write zero word *)
    zeroword := 0;
    writedata( samfile, zeroword, 2 );

      (* write sound data *)
    with note do
      begin
      i := 1;
      bytesleft := length;
        (* while more data do: *)
      while bytesleft > 0 do
        begin
          (* do bufsize bytes, or what's left, whichever is less *)
        if bytesleft > bufsize then
          thistime := bufsize
        else
          thistime := bytesleft;
          (* adjust count of bytes remaining *)
        bytesleft := bytesleft - thistime;
          (* convert signums *)
        signum_convert( data[i], thistime );
          (* write out the buffer *)
        writedata( samfile, data[i]^, thistime );
          (* go to next buffer *)
        i := i + 1;
        end; (* while more data *)
      end; (* with *)
  end; (* writesam *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure writetext(
    var outfile:             (* text file to write to *)
      text;
    st:                      (* string to write *)
      string );
    (*  This procedure encapsulates writeln(), halting the program in
        case of disk errors.  *)

  begin (* writetext *)
    {$I-} writeln( outfile, st ); {$I+}
    if IOResult <> 0 then
      stop( 'Error writing output file - halting.', '' );
  end; (* writetext *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure divmod(
    dividend,                (* number to divide *)
    divisor:                 (* number to divide by *)
      integer;
    var quotient,            (* quotient *)
        remainder:           (* remainder *)
      integer );
    (*  This procedure is a replacement for Pascal's div and mod operators.
        It returns a remainder that is always positive.  *)

  begin (* divmod *)
    remainder := dividend mod divisor;
    quotient := dividend div divisor;
    if remainder < 0 then
      if divisor < 0 then
        begin
        remainder := remainder - divisor;
        quotient := quotient + 1;
        end
      else (* divisor > 0 *)
        begin
        remainder := remainder + divisor;
        quotient := quotient - 1;
        end;
  end; (* divmod *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  function notestr(
    note:
      integer ):
        string;
    (*  This function returns a string representation of a note.  Note
        numbers are based on 0 = C2.  *)

  const
    letters: array[0..11] of string[2] =
      ( 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B' );

  var
    pitch,                   (* pitch for note (C = 0, C# = 1, etc.) *)
    octave:                  (* octave for note (middle C = C2) *)
      integer;
    octavestr:               (* octave number as string *)
      string;

  begin (* notestr *)
      (* normalize to make 0 = C0 *)
    note := note + 24;

      (* set pitch and octave *)
    divmod( note, 12, octave, pitch );

      (* get octave as string *)
    str( octave, octavestr );

      (* return *)
    notestr := letters[pitch] + octavestr;
  end; (* notestr *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  procedure writenot(
    var notfile:             (* output note file *)
      text;
    samname:                 (* name of sample file *)
      string;
    note:                    (* note to describe *)
      noterec;
    is_looped:               (* true if sample is looped *)
      boolean;
    loop_start,              (* start of looping region (in words) *)
    loop_length:             (* length of looping region (in words) *)
      longint );
    (*  This procedure writes a text file describing a .mod sample (see
        top for format).  *)

  var
    numstr1,                 (* number as string, for output *)
    numstr2:                 (* another one *)
      string;
    modedtune,               (* tuning for ModEdit, 0 = C2 *)
    transpose,               (* transposition for ModEdit in octaves *)
    intpitch:                (* .mod pitch of note, 0 = C2 *)
      integer;

  begin (* writenot *)
      (* write name *)
    writetext( notfile, 'Data for sample file ' + samname );

      (* say if no pitch set *)
    if note.pitch = $FF then
      writetext( notfile, 'No pitch set' )

      (* pitch set:  display pitch and transposition *)
    else
      begin

        (* convert .snd pitch to .mod pitch and display *)
      intpitch := note.pitch - 33;
      writetext( notfile,
        'Actual pitch at C2:  ' + notestr( intpitch ) + ' finetune +1' );

        (* determine transposition for ModEdit v.3.1 *)
      divmod( intpitch, 12, transpose, modedtune );

        (* display tuning and transposition for ModEdit v.3.1 *)
      writetext( notfile, '' );
      writetext( notfile, 'Tuning for ModEdit v.3.1:' );
      writetext( notfile, 'Set tuning to:  ' + notestr( modedtune ) );
      if transpose < 0 then
        begin
        str( -transpose, numstr1 );
        writetext( notfile, 'Transpose up ' + numstr1 + ' octave(s).' )
        end (* if transposing up *)
      else if transpose = 0 then
        writetext( notfile, 'No transposition.' )
      else
        begin
        str( transpose, numstr1 );
        writetext( notfile, 'Transpose down ' + numstr1 + ' octave(s).' );
        end; (* if transposing down *)

        (* display transposition for other editors *)
      writetext( notfile, '' );
      writetext( notfile, 'Tuning for other editors:' );
      if intpitch < 0 then
        begin
        str( -intpitch, numstr1 );
        writetext( notfile, 'Transpose up ' + numstr1 + ' semitone(s).' )
        end (* if transposing up *)
      else if intpitch = 0 then
        writetext( notfile, 'No transposition.' )
      else
        begin
        str( intpitch, numstr1 );
        writetext( notfile, 'Transpose down ' + numstr1 + ' semitone(s).' );
        end; (* if transposing down *)
      end; (* if note set *)

      (* write looping information *)
    writetext( notfile, '' );
    if is_looped then
      begin
      writetext( notfile, 'Sample is looped.' );
      str( loop_start*2, numstr1 );
      str( loop_start, numstr2 );
      writetext( notfile,
        'Repeat start:  ' + numstr1 + ' (' + numstr2 + ' words)' );
      str( loop_length*2, numstr1 );
      str( loop_length, numstr2 );
      writetext( notfile,
        'Repeat length:  ' + numstr1 + ' (' + numstr2 + ' words)' );
      end (* if looped *)
    else
      writetext( notfile, 'Sample is not looped.' );
  end; (* writenot *)

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

begin (* do_note *)
    (* if the note is not valid, just exit *)
  if not note.valid then
    exit;

    (* set names *)
  samname := basename + '.sam';
  notname := basename + '.not';

    (* compute looping information *)
  compute_loop( note, is_looped, loop_start, loop_length );

    (* open the .sam file *)
  assign( samfile, samname );
  {$I-} rewrite( samfile, 1 ); {$I+}
  if IOResult <> 0 then
    stop( 'Error creating file "' + samname + '" in directory',
          '"' + outdir + '" - halting.' );

    (* write and close the .sam file *)
  writeln( '  Writing file ', samname, ' ...' );
  writesam( samfile, note );
  close( samfile );

    (* open the .not file *)
  assign( notfile, notname );
  {$I-} rewrite( notfile ); {$I-}
  if IOResult <> 0 then
    stop( 'Error creating file "' + notname + '" in directory',
          '"' + outdir + '" - halting.' );

    (* write and close the .not file *)
  writeln( '  Writing file ', notname, ' ...' );
  writenot( notfile, samname, note, is_looped, loop_start,
    loop_length );
  close( notfile );
end; (* do_note *)

(*********************************************************************)
(************************** exit procedure ***************************)
(*********************************************************************)

{$F+} procedure mainexit; {$F-}
  (*  This procedure is executed automatically when the program exits for
      any reason.  It sets the current directory back to what it was when
      the program was invoked.  *)

begin (* mainexit *)
  chdir( currentdir );
  exitproc := nextexit;
end; (* mainexit *)

(*********************************************************************)
(*************************** main program ****************************)
(*********************************************************************)

begin (* snd2sam *)
    (* display intro message *)
  display_intro;

    (* get current directory and set up exit procedure *)
  getdir( 0, currentdir );
  nextexit := exitproc;
  exitproc := @mainexit;

    (* process the command-line parameters *)
  process_command_line( sndname, outdir );

    (* read in sound data *)
  if is_newsnd( sndname ) then
    read_newsnd( sndname, numnotes, notelist )
  else
    read_oldsnd( sndname, numnotes, notelist );

    (* change to sample directory *)
  {$I-} chdir( outdir ); {$I+}
  if IOResult <> 0 then
    stop( 'Invalid sample directory:',
          '  ' + outdir );
  writeln( 'Writing to directory "', outdir, '":' );

    (* set sample file name *)
  get_basename( sndname, basename );

    (* convert the notes to samples *)
  for note := 1 to numnotes do
    do_note( outdir, setname( basename, note ), notelist[note] );

    (* success *)
  writeln( 'Done.' );
end. (* snd2sam *)